home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATHLIB2 / MATHLIB.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-14  |  8KB  |  279 lines
  1. Unit MATHLIB;
  2.  
  3. (* Bibliotheque mathematique pour type real
  4.   JD GAYRARD Fev. 94
  5.  la bibliotheque est batie à partir des fonctions :
  6.   ARCTAN, COS, EXP, LN, SIN, SQRT
  7.   elle fournit les fonctions :
  8.  ARCCOS, ARCSIN, ARCTAN2, LOG, TAN, PUISSANCE, SIGNE, MAX, MIN *)
  9.  
  10. (* Revision 1.0 de Jul. 95 pour :
  11. - passage en double
  12. - ajout de la fonction pwr_int, factorielle
  13. - correction de puissance *)
  14.  
  15. (* revision 1.1 de Sep. 95 pour :
  16. - passage en float
  17. - correction de log (test valeur negative)
  18. - ajout de ceiling, floor, Uran et Gran *)
  19.  
  20. (* revision 1.2 de Oct 95 pour :
  21. - ajout de ten_to, module, deg_to_rad, rad_to_deg *)
  22.  
  23. {$G+}
  24. {$N+}
  25. {$E-}
  26.  
  27. interface
  28.  
  29. const author  = 'GAYRARD J-D';
  30.       version = 'ver 1.2 - 10/95';
  31.  
  32. const PI_2      =  1.570796326794896619231322;   { pi / 2 }
  33.       PI_3      =  1.047197551196597746154214;   { pi / 3 }
  34.       PI_4      =  0.7853981633974483096156608;  { pi / 4 }
  35.       SQRT_PI   =  1.772453850905516027298167;   { sqrt(pi) }
  36.       SQRT_2PI  =  2.506628274631000502415765;   { sqrt(2.pi) }
  37.       TWO_PI    =  6.283185307179586476925287;   { 2.pi }
  38.       LN_PI     =  1.144729885849400174143427;   { ln(pi) }
  39.       LOG_PI    =  0.4971498726941338543512683;  { log(pi) }
  40.       LOG_E     =  0.4342944819032518276511289;  { log(e) }
  41.       LN_10     =  2.302585092994045684017991;   { ln(10) }
  42.       E         =  2.718281828459045235360287;   { exp(1) }
  43.       ONE_RAD   = 57.295779513082320876798155;   { 1 rad in ° }
  44.       ONE_DEG   =  0.017453292519943295769237;   { 1° in rad }
  45.  
  46. type float = double; { a modifier suivant l'utilisation }
  47.  
  48. (* utilisable avec tout types de reel et avec controle du domaine
  49. de definition des fonctions *)
  50.  
  51. function tan(x : float): float;
  52. function arcsin(x : float): float;
  53. function arccos(x : float): float;
  54. function arctan2(x, y : float): float;          { retourne arctan (y/x) }
  55. function log(x : float): float;
  56. function y_to_x( y, x : float): float;          { retourne y^x}
  57. function signe(x, y : float): float;            { retourne x avec le signe de y }
  58. function max(x, y : float): float;
  59. function min(x, y : float): float;
  60. function pwr_int(x : float; n : integer): float;   { retourne x^n }
  61. function ten_to(x : float): float;                 { retourne 10^x }
  62. function fac(n : integer): float;                  { retourne x! }
  63. function Uran: float;                              { uniform law }
  64. function Gran: float;                              { gaussian law }
  65. function ceiling(x : float): float;
  66. function floor(x : float): float;
  67. function module(x, y : float): float;
  68. function deg_to_rad(x : float): float;
  69. function rad_to_deg(x : float): float;
  70.  
  71. implementation
  72.  
  73. function Uran: float;
  74. (* loi uniforme *)
  75. begin
  76. uran := random
  77. end;
  78.  
  79. function Gran: float;
  80. (* loi gaussienne *)
  81. var k : integer;
  82.     sum : float;
  83. begin
  84. sum := 0.0;
  85. for k := 0 to 16 do sum := sum + random;
  86. gran := sum / 16.0
  87. end;
  88.  
  89. function signe(x, y : float): float;
  90. (* retourne x avec le signe de y *)
  91. begin
  92. if x > 0.0 then if y > 0.0 then signe := x
  93.                            else signe := -x
  94.            else if y < 0.0 then signe := x
  95.                            else signe := -x
  96. end;
  97.  
  98. function min(x, y : float): float;
  99. (* retourne le plus petit *)
  100. begin
  101. if x > y then min := y
  102.          else min := x
  103. end;
  104.  
  105. function max(x, y : float): float;
  106. (* retourne le plus grand *)
  107. begin
  108. if x < y then max := y
  109.          else max := x
  110. end;
  111.  
  112. function ceiling(x : float): float;
  113. { return the nearest integer value above x }
  114. begin
  115. if x <> int(x) then ceiling := int(x) + 1
  116.                else ceiling := x
  117. end;
  118.  
  119. function floor(x : float): float;
  120. { return the nearest integer value below x }
  121. begin
  122. if x <> int(x) then floor := int(x) - 1
  123.                else floor := x
  124. end;
  125.  
  126. function module(x, y : float): float;
  127. { retourne sqrt( x.x + y.y), distance du point (x,y) a l'origine (0,0) }
  128. begin
  129. module := sqrt(x * x + y * y)
  130. end;
  131.  
  132. function tan(x : float): float;
  133. (* retourne la tangente de x (en radian) *)
  134. var cosx : float;
  135. begin
  136. cosx := cos(x);
  137. if cosx = 0.0
  138.    then begin
  139.         writeln('******* Fonction tan ********');
  140.         writeln('********* OVERFLOW **********');
  141.         halt
  142.         end
  143.    else tan := sin(x) / cosx
  144. end;
  145.  
  146. function arcsin(x : float): float;
  147. (* retourne l'arcsin de x, x compris entre -1 et 1 *)
  148. {                           ________
  149.    arcsin(x) = arctan( x / V 1 - x.x ) }
  150. begin
  151. if (x > 1.0) or (x < -1.0)
  152.    then begin
  153.         writeln('****** Fonction arcsin ******');
  154.         writeln('********* OVERFLOW **********');
  155.         halt
  156.         end
  157.    else if x = 0.0
  158.            then arcsin := 0.0
  159.            else if x = 1.0
  160.                    then arcsin := pi_2
  161.                    else if x = -1.0
  162.                            then arcsin := - pi_2
  163.                            else arcsin := arctan(x / sqrt( 1.0 - x * x))
  164. end;
  165.  
  166. function arccos(x : float): float;
  167. (* retourne l'arccos de x, x compris entre -1 et 1 *)
  168. {                       ________
  169.    arcsin(x) = arctan( V 1 - x.x / x ) }
  170. var y : float;
  171. begin
  172. if (x > 1.0) or (x < -1.0)
  173.    then begin
  174.         writeln('****** Fonction arccos ******');
  175.         writeln('********* OVERFLOW **********');
  176.         halt
  177.         end
  178.    else if x = 0.0
  179.            then arccos := pi_2
  180.            else if x = 1.0
  181.                 then arccos := 0.0
  182.                 else if x = -1.0
  183.                         then arccos := pi
  184.                         else begin
  185.                              y := arctan(sqrt( 1.0 - x * x) / x);
  186.                              if x > 0.0
  187.                                 then arccos := y
  188.                                 else arccos := y + pi;
  189.                              end
  190. end;
  191.  
  192. function arctan2(x, y : float): float;
  193. { retourne l'arctan de y/x }
  194. begin
  195. if x = 0.0
  196.    then arctan2 := signe(pi_2, y)
  197.    else if x > 0.0
  198.         then arctan2 := arctan(y/x)
  199.         else arctan2 := arctan(y/x) + signe(pi,y)
  200. end;
  201.  
  202. function y_to_x (y, x : float): float;
  203. (* retourne y^x, y positif par la methode e^x.ln(y) *)
  204. begin
  205. if y >= 0 then y_to_x := exp( x * ln(y))
  206.           else begin
  207.                writeln('****** Fonction puissance ******');
  208.                writeln('****** NEGATIVE ARGUMENT *******');
  209.                halt
  210.                end
  211. end;
  212.  
  213. function ten_to(x : float): float;
  214. begin
  215. ten_to := exp(x * LN_10)
  216. end;
  217.  
  218. function log(x : float): float;
  219. (* retourne de logarithme decimal de x, x positif
  220. utilise la methode log10(x) = ln(x)/ln(10) *)
  221. begin
  222. if x >= 0 then log := log_E * ln(x)
  223.           else begin
  224.                writeln('********* Fonction log *********');
  225.                writeln('****** NEGATIVE ARGUMENT *******');
  226.                halt
  227.                end
  228. end;
  229.  
  230. function pwr_int(x : float; n : integer) : float;
  231. { retourne x^n, n entier, utilise la methode multiplicative }
  232. var       temp : float;
  233.           i : integer;
  234. begin
  235. if n = 0 then pwr_int := 1.0
  236.          else
  237.    if (x = 0.0) or (n = 1) then pwr_int := x
  238.                            else
  239.              begin
  240.              temp := 1.0;
  241.              for i := 1 to abs(n) do temp := temp * x;
  242.              if n > 0 then pwr_int := temp
  243.                       else pwr_int := 1.0 / temp
  244.              end
  245. end;
  246.  
  247. function fac(n : integer): float;
  248. (* returne n! , n > 0 *)
  249. var temp : float;
  250.     i : integer;
  251. begin
  252. if n <= 0 then begin
  253.                writeln('********* Fonction fac *********');
  254.                writeln('****** NEGATIVE ARGUMENT *******');
  255.                halt
  256.                end
  257.           else begin
  258.                temp := 1.0;
  259.                for i := 2 to n do temp := temp * i;
  260.                fac := temp
  261.                end
  262. end;
  263.  
  264. function deg_to_rad(x : float): float;
  265. { conversion degres vers radians }
  266. begin
  267. deg_to_rad := one_deg * x
  268. end;
  269.  
  270. function rad_to_deg(x : float): float;
  271. {conversion radians vers degres }
  272. begin
  273. rad_to_deg := one_rad * x
  274. end;
  275.  
  276. begin
  277. randomize
  278. end.
  279.